/*-------------------<-- Start of Description-->---------------------\ | List repeated formula based on the number of variables; basically | | it replace the "vars" in the formula you listed with the variables | | you listed respectively; | |---------------------<-- End of Description-->----------------------| |--------------------------------------------------------------------| |-----------<-- Start of Files or Arguements Needed-->---------------| | Arguments: | | var - list of variable names; | | formula - the formula you want to list. | | val - the value list, if there are more than value; | | logic - the logic operator you want about these formulas; | |-----------------<-- End of Arguements Needed-->--------------------| |--------------------------------------------------------------------| |------------------<-- Start of Files Created-->---------------------| | Example: %put %listfml(var=var1 var3 var4-var10 test, | | formula=(index(upcase(vars), 'TEST') >= 1), logic=or); | | Usage: %listfml(var=, formula=vars vals, val=, logic=); | \-------------------<-- End of Files Created-->---------------------*/ %macro listfml/parmbuff; /*---------------------------------------------\ | Copy Right: Duo Zhou; | | Created: 10-15-2002 9:54pm; | | Purpose: list the formula using the variable,| | value lists and the logic you gave; | \---------------------------------------------*/ %local var formula val logic list vallist; %let _allfmls_=; %let formula=; %let val=; %let var=; %let logic=; %let list=; %let vallist=; %let syspbuff=%sysfunc(translate(%quote(%substr(%quote(%trim(%quote(%left(%quote(&syspbuff))))), 2, %eval(%length(%trim(%quote(%left(%quote(&syspbuff)))))-2))), %str(%'), %str(%"))); /****/ %let _xlistfmlrx_=%sysfunc(rxparse($(1))); %let _xlistfmlpos_=0; %let _xlistfmllen_=0; %let _xlistfmloldstr_=; %let _xlistfmllfmlnewstr_=; %do %while( %sysfunc(rxmatch(&_xlistfmlrx_, %quote(&syspbuff))) ); %syscall rxsubstr(_xlistfmlrx_, syspbuff, _xlistfmlpos_, _xlistfmllen_); %let _xlistfmloldstr_=%quote(%substr(%quote(&syspbuff), &_xlistfmlpos_, &_xlistfmllen_)); %let _xlistfmllfmlnewstr_=%quote(%sysfunc(translate(%quote(&_xlistfmloldstr_), À, %quote(%(), Á, %quote(%)), ´, %quote(,), ®, %quote( )))); %let syspbuff=%sysfunc(tranwrd(%quote(&syspbuff), %quote(&_xlistfmloldstr_), %quote(&_xlistfmllfmlnewstr_))); %let _xlistfmlpos_=0; %let _xlistfmllen_=0; %let _xlistfmloldstr_=; %let _xlistfmllfmlnewstr_=; %end; %let _lfmlnewstr_=&syspbuff; %local _xlfmlvarcnt_ _xlfmlvar_; %let _xlfmlvarcnt_=0; %do %while(%length(%qscan(%nrbquote(&_lfmlnewstr_), %eval(&_xlfmlvarcnt_+1), %nrbquote(,)))); %let _xlfmlvarcnt_=%eval(&_xlfmlvarcnt_+1); %let _xlfmlvar_=%nrbquote(%qscan(%nrbquote(&_lfmlnewstr_), &_xlfmlvarcnt_, %nrbquote(,))); %let _xlfmlvar_=%sysfunc(translate(%quote(&_xlfmlvar_), '(', 'À', ')', 'Á', ',', '´', ' ', '®')); %let _xlfmlx2_=%trim(%left(%qscan(%quote(&_xlfmlvar_), 1, %str(=)))); %let _xlfmlx3_=%substr(%quote(&_xlfmlvar_), %eval(%index(%quote(&_xlfmlvar_),%str(=))+1), %eval(%length(&_xlfmlvar_)-%index(%quote(&_xlfmlvar_),%str(=)))); %if (not %index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&_xlfmlvar_))))), %str(=))) %then %do; %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&_xlfmlx2_))))), %str(%()) eq 1) and (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(&_xlfmlx2_))))))), %str(%))) eq 1) %then %let _xlfmlx3_=%substr(%quote(%trim(%quote(%left(%quote(&_xlfmlx2_))))), 2, %eval(%length(%trim(%quote(%left(%quote(&_xlfmlx2_)))))-2)); %if (%quote(&_xlfmlvarcnt_) = %quote(1)) %then %let var=&_xlfmlx3_; %else %if (%quote(&_xlfmlvarcnt_) = %quote(2)) %then %let formula=&_xlfmlx3_; %else %if ((%quote(&_xlfmlvarcnt_) = %quote(3)) or (%quote(&_xlfmlvarcnt_) = %quote(4))) and (not %index(%quote(%upcase(&_xlfmlx3_)), %str(AND))) and (not %index(%quote(%upcase(&_xlfmlx3_)), %str(OR))) %then %let val=&_xlfmlx3_; %else %let logic=&_xlfmlx3_; %end; %else %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&_xlfmlx3_))))), %str(%()) eq 1) and (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(&_xlfmlx3_))))))), %str(%))) eq 1) and (%index(%nrbquote(upcase(%nrbquote(%sysfunc(compress(%nrbquote(&_xlfmlx2_)))))), WHERE=) le 1) %then %let &_xlfmlx2_=%substr(%quote(%trim(%quote(%left(%quote(&_xlfmlx3_))))), 2, %eval(%length(%trim(%quote(%left(%quote(&_xlfmlx3_)))))-2)); %else %let &_xlfmlx2_=&_xlfmlx3_; %end; %if (%quote(&val) eq) and (%quote(&list) ne) %then %let val=&list; %else %if (%quote(&val) eq) and (%quote(&vallist) ne) %then %let val=&vallist; /****/ %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&var))))), %str(%()) eq 1) and (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(%quote(&var)))))))), %str(%))) eq 1) %then %let var=%substr(%quote(%trim(%quote(%left(%quote(&var))))), 2, %eval(%length(%trim(%quote(%left(%quote(&var)))))-2)); %if (%length(%bquote(&var)) gt 0) and (%quote(%upcase(&formula)) ne %quote(VARS VALS)) %then %do; /****/ %if (%quote(&val) ne) %then %do; %let val=%sysfunc(translate(%quote(&val), %str(%"), %str(%'))); %if (%chk_type(%quote(&val)) eq 2) and (%index(%quote(&val), %str(%"))) and (%index(%quote(&val), %quote(,))) %then %do; %let listfmlvallen=%length(%quote(%trim(%quote(%left(%quote(&val)))))); %do %while((&listfmlvallen gt %length(%quote(%trim(%quote(%left(%quote(%sysfunc(tranwrd(%quote(&val),%quote(", "), %quote(",")))))))))) or (&listfmlvallen gt %length(%quote(%trim(%quote(%left(%quote(%sysfunc(tranwrd(%quote(&val),%quote(" ,"), %quote(","))))))))))); %let val=%sysfunc(tranwrd(%quote(&val),%quote(", "), %quote(","))); %let val=%sysfunc(tranwrd(%quote(&val),%quote(" ,"), %quote(","))); %let listfmlvallen=%length(%quote(%trim(%quote(%left(%quote(&val)))))); %end; %let listfmlvaltype=2; %let listfmldlm=%str((),""); %end; %else %if (%chk_type(%quote(&val)) eq 2) and (%index(%quote(&val), %str(%"))) and (not %index(%quote(&val), %quote(,))) %then %do; %let val=%sysfunc(tranwrd(%quote(&val),%quote(" "), %quote(""))); %let listfmlvaltype=2; %let listfmldlm=%str(()""); %end; %else %if (%chk_type(%quote(&val)) eq 1) %then %do; %let listfmlvaltype=1; %let listfmldlm=%quote( ()); %end; %else %do; %let listfmlvaltype=2; %let listfmldlm=%quote( ()); %end; %end; /****/ %if (%index(%quote(&var), %quote(,))) %then %let _vardlm_=%quote(,); %else %let _vardlm_=%quote( ); /*Add some code to recognize the format of var10-var20, replace with var10 var11 ... var20*/ %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&var))))), %str(%()) eq 1) and (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(%quote(&var)))))))), %str(%))) eq 1) %then %let var=%substr(%quote(%trim(%left(&var))), 2, %eval(%length(%quote(%trim(%left(&var))))-2)); %if (%index(%quote(%upcase(&formula)), %str(VARS))) %then %let _fmlvar_=%substr(&formula, (%index(%quote(%upcase(&formula)), %quote(VARS))), %length(VARS)); %else %if (%index(%quote(%upcase(&formula)), %str(VAR))) %then %let _fmlvar_=%substr(&formula, (%index(%quote(%upcase(&formula)), %quote(VAR))), %length(VAR)); %if (%index(%quote(%upcase(&formula)), %str(VALS))) %then %let _fmlval_=%substr(&formula, (%index(%quote(%upcase(&formula)), %quote(VALS))), %length(VALS)); %else %if (%index(%quote(%upcase(&formula)), %str(VAL))) %then %let _fmlval_=%substr(&formula, (%index(%quote(%upcase(&formula)), %quote(VAL))), %length(VAL)); %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&formula))))), %str(%()) ne 1) or (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(%quote(&formula)))))))), %str(%))) ne 1) %then %let formula=(&formula); %if (%quote(&var) ne) %then %do; %let _convar_=; %do %while(%index(%quote(&var), %str(-))); %let _sub1var_=%substr(%quote(&var), 1, %eval(%index(%quote(&var), %str(-))-1)); %let var=%substr(%quote(&var), %eval(%index(%quote(&var), %str(-))+1), %eval(%length(&var)-%index(%quote(&var), %str(-)))); %let _tmpvari_=0; %do %while(%length(%nrbquote(%scan(%nrbquote(&_sub1var_), %eval(&_tmpvari_+1), %nrbquote(&_vardlm_))))); %let _tmpvari_=%eval(&_tmpvari_+1); %let _tmp1var_=%nrbquote(%qscan(%nrbquote(&_sub1var_), &_tmpvari_, %%nrbquote(&_vardlm_))); %if (%length(%nrbquote(%scan(%nrbquote(&_sub1var_), %eval(&_tmpvari_+1), %nrbquote(&_vardlm_))))) %then %do; %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_)))); %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_)))); %end; %else %if ( %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_)))+1)) %then %do; %let _arrvarbeg_=%substr(%quote(&_tmp1var_), %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_)))+1), %eval(%length(&_tmp1var_)- %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_)))))); %if (%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_))) ge 1) %then %let _arrvarbroot_=%substr(%quote(&_tmp1var_), 1, %sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp1var_)))); %else %let _arrvarbroot_=; %if (%quote(&var) ne) %then %do; %let _tmp2var_=%nrbquote(%qscan(%nrbquote(&var), 1, %%nrbquote(&_vardlm_))); %if (%sysfunc(rxmatch(%sysfunc(rxparse($d $s)),&_tmp2var_))) %then %do; %let _arrvarend_=%substr(%quote(&_tmp2var_), %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_)))+1), %eval(%length(&_tmp2var_)- %eval(%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_)))))); %if (%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_))) ge 1) %then %let _arrvareroot_=%substr(%quote(&_tmp2var_), 1,%sysfunc(rxmatch(%sysfunc(rxparse($- ($a|_))),%quote(&_tmp2var_)))); %else %let _arrvareroot_=; %if (%quote(&_arrvarbroot_) eq %quote(&_arrvareroot_)) %then %do; %do _locali_=&_arrvarbeg_ %to %eval(&_arrvarend_-1); %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%left(&_arrvarbroot_))%trim(%left(&_locali_)); %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%left(&_arrvarbroot_))%trim(%left(&_locali_)); %end; %end; %else %do; %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_)))); %else %let _convar_=%trim(%quote(%left(&_convar_)))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_)))); %put ==> Alert! Variable name &_tmp1var_ and &_tmp2var_ do not have the same pattern!; %end; %end; %else %do; %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_)))); %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_)))); %put ==> Alert! Variable name &_tmp2var_ does not have a numeric suffix!; %end; %end; %else %do; %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_)))); %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_)))); %put ==> Alert! No variable names are provided after &_tmp1var_ -!; %end; %end; %else %do; %if (%quote(&_convar_) eq) %then %let _convar_=%trim(%quote(%left(%quote(&_tmp1var_)))); %else %let _convar_=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&_tmp1var_)))); %put ==> Alert! Variable name &_tmp1var_ does not have a numeric suffix!; %end; %end; %end; %let var=%trim(%quote(%left(%quote(&_convar_))))%quote(&_vardlm_)%trim(%quote(%left(%quote(&var)))); %end; /*End of change*/ %let _listfmljvar_=0; %do %while(%length(%quote(%qscan(%quote(&var), %eval(&_listfmljvar_+1), %quote(&_vardlm_))))); %let _listfmljvar_=%eval(&_listfmljvar_+1); %let _listfmlvarj_=%qscan(%quote(&var), &_listfmljvar_, %quote(&_vardlm_)); %let _listfmlj_=%sysfunc(tranwrd(%quote(&formula), %quote(&_fmlvar_), %quote(&_listfmlvarj_))); %if (%quote(&val) ne) %then %do; %let _listfmlwcount_=0; %do %while(%length(%nrbquote(%scan(%nrbquote(&val), %eval(&_listfmlwcount_+1), %nrbquote(&listfmldlm))))); %let _listfmlwcount_=%eval(&_listfmlwcount_+1); %let _listfmlval_=%nrbquote(%qscan(%nrbquote(&val), &_listfmlwcount_, %nrbquote(&listfmldlm))); %let _listfmlvalj_=%sysfunc(tranwrd(%quote(&_listfmlj_), %quote(&_fmlval_), %quote(&_listfmlval_))); %if (&_listfmljvar_ eq 1) and (&_listfmlwcount_ eq 1) %then %let _allfmls_=&_listfmlvalj_; %else %if (&_listfmljvar_ gt 1) or (&_listfmlwcount_ gt 1) %then %let _allfmls_=%trim(%bquote(%left(%bquote(&_allfmls_)))) &logic %trim(%bquote(%left(%bquote(&_listfmlvalj_)))); %end; %end; %else %do; %if (%quote(&_listfmljvar_) eq 1) %then %let _allfmls_=&_listfmlj_; %else %if (%length(&_listfmlvarj_) gt 0) %then %let _allfmls_=%trim(%bquote(%left(%bquote(&_allfmls_)))) &logic %trim(%bquote(%left(%bquote(&_listfmlj_)))); %end; %end; %end; %else %do; %put ==> Alert! No variables or no formula is provided!; %end; %if (%quote(&_allfmls_) ne) %then &_allfmls_; %mend listfml;